home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / program / tvichw32.zip / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-13  |  11KB  |  421 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,IniFiles,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, Spin, Grids,
  8.   HW_32;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     GroupBox2: TGroupBox;
  13.     B_Read: TButton;
  14.     B_ReadAll: TButton;
  15.     B_Write: TButton;
  16.     B_WriteAll: TButton;
  17.     BitBtn3: TBitBtn;
  18.     GroupBox3: TGroupBox;
  19.     Label12: TLabel;
  20.     E_Addr: TEdit;
  21.     B_SetMemory: TButton;
  22.     B_ReadMemory: TButton;
  23.     B_Open: TButton;
  24.     GRead: TStringGrid;
  25.     MemoHex: TStringGrid;
  26.     GWrite: TStringGrid;
  27.     GroupBox1: TGroupBox;
  28.     Timer1: TTimer;
  29.     L_Flag: TLabel;
  30.     L_Gen: TLabel;
  31.     Label1: TLabel;
  32.     Label2: TLabel;
  33.     B_SetIRQ: TButton;
  34.     B_Mask: TButton;
  35.     SpinIRQ: TSpinEdit;
  36.     Label5: TLabel;
  37.     B_FillMemory: TButton;
  38.     B_Pulse: TButton;
  39.     L_Timers: TLabel;
  40.     Label7: TLabel;
  41.     C_Hard: TCheckBox;
  42.     Panel1: TPanel;
  43.     Label4: TLabel;
  44.     Label6: TLabel;
  45.     Label8: TLabel;
  46.     Label9: TLabel;
  47.     Label3: TLabel;
  48.     HwCtrl: TVicHw32;
  49.     procedure B_OpenClick(Sender: TObject);
  50.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  51.     procedure FormActivate(Sender: TObject);
  52.     procedure BitBtn3Click(Sender: TObject);
  53.     procedure GReadSelectCell(Sender: TObject; Col, Row: Longint;
  54.       var CanSelect: Boolean);
  55.     procedure B_WriteClick(Sender: TObject);
  56.     procedure B_WriteAllClick(Sender: TObject);
  57.     procedure B_ReadClick(Sender: TObject);
  58.     procedure B_ReadAllClick(Sender: TObject);
  59.     procedure B_SetMemoryClick(Sender: TObject);
  60.     procedure B_ReadMemoryClick(Sender: TObject);
  61.     procedure E_AddrChange(Sender: TObject);
  62.     procedure HWCtrlHwInterrupt(Sender: TObject);
  63.     procedure Timer1Timer(Sender: TObject);
  64.     procedure B_SetIRQClick(Sender: TObject);
  65.     procedure B_MaskClick(Sender: TObject);
  66.     procedure SpinIRQChange(Sender: TObject);
  67.     procedure B_FillMemoryClick(Sender: TObject);
  68.     procedure B_PulseClick(Sender: TObject);
  69.     procedure C_HardClick(Sender: TObject);
  70.   end;
  71.  
  72. const MaxPorts = 16;
  73.  
  74. var
  75.   MainForm: TMainForm;
  76.   PortWSel,PortRSel:Word;
  77.   ValWSel:Byte;
  78.   NomWSel,NomRSel:Byte;
  79.   PhysAddr : dWord;
  80.   TestString : array[0..255]of Char;
  81.   TestVar : LongInt;
  82. type SingleData = array[1..16] of Byte;
  83.      SegData    = array[1..16] of SingleData;
  84.      tPointPhys =^SegData;
  85.  
  86. var  PointPhys  : tPointPhys;
  87.      Flag_Intr  : LongInt;
  88.      Flag_tim   : LongInt;
  89.      Sum_Ticks,CurrTicker, OldTicker : Longint;
  90. implementation
  91.  
  92. {$R *.DFM}
  93.  
  94. procedure ShowButtons;
  95. begin
  96.   with MainForm,HwCtrl do
  97.   begin
  98.    C_Hard.Checked:=HardAccess;
  99.    SpinIRQ.Enabled:=not IsIRQSet;
  100.    if ActiveHW then B_Open.caption:='Close Driver'
  101.                else B_Open.caption:='Open Driver';
  102.    B_Write.Enabled:=ActiveHW;
  103.    B_Read.Enabled:=ActiveHW;
  104.    B_WriteAll.Enabled:=ActiveHW;
  105.    B_ReadAll.Enabled:=ActiveHW;
  106.    B_ReadMemory.Enabled:=ActiveHW and (PointPhys<>NIL);
  107.    B_FillMemory.Enabled:=ActiveHW and (PointPhys<>NIL);
  108.    B_SetIRQ.Enabled:=ActiveHW;
  109.    if IsIRQSet then B_SetIRQ.caption:='Destroy IRQ'
  110.                else B_SetIRQ.caption:='Set IRQ';
  111.    B_Pulse.Enabled:=ActiveHW and IsIRQSet and Masked;
  112.    B_Mask.Enabled:=ActiveHW and IsIRQSet;
  113.    if Masked then B_Mask.caption:='Unmask IRQ'
  114.              else B_Mask.caption:='Mask IRQ';
  115.   end;
  116. end;
  117.  
  118. procedure TMainForm.B_OpenClick(Sender: TObject);
  119. begin
  120.   if HwCtrl.ActiveHW then begin HwCtrl.CloseDriver; PointPhys:=NIL; end
  121.   else begin
  122.          HwCtrl.OpenDriver;
  123.          if not HwCtrl.ActiveHW then
  124.          begin
  125.            MessageBeep(0);
  126.            Application.MessageBox('Driver "VICHWxx" not found',
  127.                       ' Warning! ',mb_OK or mb_ICONHAND);
  128.          end;
  129.        end;
  130.   B_SetMemory.Enabled:=HwCtrl.ActiveHW;     
  131.   ShowButtons;
  132. end;
  133.  
  134. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  135. begin
  136.   HwCtrl.CloseDriver;
  137.   ShowButtons;
  138. end;
  139.  
  140. procedure TMainForm.FormActivate(Sender: TObject);
  141. var MyIniFile : TIniFile;
  142.     i         : Word;
  143. begin
  144.  
  145.  MyInifile:=TIniFile.Create('HW_test.ini');
  146.  
  147.  with MyIniFile,HWCtrl do
  148.  begin
  149.  
  150.   if GetVersion<0 then Label3.caption:='Detected: Windows 95'
  151.                   else Label3.caption:='Detected: Windows NT';
  152.   PhysAddr:=ReadInteger('misc','ADDR',$F8000);
  153.   IRQNumber:=ReadInteger('misc','IRQ',10);
  154.   SpinIRQ.Value:=IRQNumber;
  155.   E_Addr.text:=IntToHex(PhysAddr,8);
  156.   for i:=1 to MaxPorts do
  157.   begin
  158.     with GWrite do
  159.     begin
  160.       Cells[0,i]:=IntToStr(i);
  161.       Cells[1,0]:='PORT'; Cells[2,0]:='VAL';
  162.       Cells[1,i]:=ReadString('PortW','Port'+IntToStr(i),'');
  163.       Cells[2,i]:=ReadString('Values','Val'+IntToStr(i),'');
  164.     end;
  165.     with GRead do
  166.     begin
  167.       Cells[0,i]:=IntToStr(i);
  168.       Cells[1,0]:='PORT'; Cells[2,0]:='VAL';
  169.       Cells[1,i]:=ReadString('PortR','Port'+IntToStr(i),'');
  170.     end;
  171.   end;
  172.  end;
  173.  MyIniFile.Free;
  174.  with MemoHex do
  175.  begin
  176.    Cells[0,0]:='  ADDR';
  177.    Cells[1,0]:='             HEX';
  178.    Cells[2,0]:='     ASCII';
  179.  end;
  180.  ShowButtons;
  181. end;
  182.  
  183. procedure TMainForm.BitBtn3Click(Sender: TObject);
  184. var MyIniFile : TIniFile;
  185.     i         : Word;
  186. begin
  187.  MyInifile:=TIniFile.Create('HW_test.ini');
  188.  with MyIniFile,HWCtrl  do
  189.  begin
  190.   WriteInteger('misc','ADDR',PhysAddr);
  191.   WriteInteger('misc','IRQ',IRQNumber);
  192.   for i:=1 to MaxPorts do
  193.   begin
  194.     with GWrite do
  195.     begin
  196.       WriteString('PortW','Port'+IntToStr(i),Cells[1,i]);
  197.       WriteString('Values','Val'+IntToStr(i),Cells[2,i]);
  198.     end;
  199.     with GRead do
  200.     begin
  201.       WriteString('PortR','Port'+IntToStr(i),Cells[1,i]);
  202.     end;
  203.   end;
  204.  end;
  205.  MyIniFile.Free;
  206.  Close;
  207. end;
  208.  
  209. function HexToInt(s:String):dWord;
  210. const hexch:array[0..15] of Char='0123456789ABCDEF';
  211. var i,j : Byte;
  212.     r,n,k:dWord;
  213.     ch : Char;
  214. begin
  215.   k:=1; r:=0;
  216.   for i:=Length(s) downto 1 do
  217.   begin
  218.     ch:=s[i]; n:=0;
  219.     for j:=0 to 15 do if UpperCase(ch)=hexch[j] then n:=j;
  220.     r:=r+n*k; if i>1 then k:=k*16;
  221.   end;
  222.   Result:=r;
  223. end;
  224.  
  225. procedure TMainForm.GReadSelectCell(Sender: TObject; Col, Row: Longint;
  226.   var CanSelect: Boolean);
  227. begin
  228.   with GRead do
  229.   begin
  230.     PortRSel:=HexToInt(Cells[1,Row]); NomRSel:=Row;
  231.   end;
  232. end;
  233.  
  234. procedure TMainForm.B_WriteClick(Sender: TObject);
  235. begin
  236.  with GWrite,HwCtrl do
  237.  begin
  238.    PortWSel:=HexToInt(Cells[1,Row]);    Cells[1,Row]:=IntToHex(PortWSel,4);
  239.    ValWSel:=HexToInt(Cells[2,Row]);     Cells[2,Row]:=IntToHex(ValWSel,2);
  240.    NomWSel:=Row;
  241.    if (PortWSel=0) then begin MessageBeep(0); Exit; end;
  242.    Port[PortWSel]    :=ValWSel;
  243.  end;
  244. end;
  245. procedure TMainForm.B_WriteAllClick(Sender: TObject);
  246. var i,v       : Byte;
  247.     P,N       : Word;
  248.     values    : array[1..16] of Byte;
  249.     ports     : array[1..16] of Word;
  250. begin
  251.  with GWrite,HwCtrl do
  252.  begin
  253.    N:=0;
  254.    for i:=1 to MaxPorts do
  255.    begin
  256.      P:=HexToInt(Cells[1,i]); Cells[1,i]:=IntToHex(P,4);
  257.      if p>0 then
  258.      begin
  259.        V:=HexToInt(Cells[2,i]); Cells[2,i]:=IntToHex(v,2);
  260.        Inc(N); values[N]:=V; ports[N]:=P;
  261.        Port[P]:=V;
  262.      end;
  263.    end;
  264.  end;
  265. end;
  266.  
  267. procedure TMainForm.B_ReadClick(Sender: TObject);
  268. var b : Byte;
  269. begin
  270.  with GRead,HwCtrl do
  271.  begin
  272.    PortRSel:=HexToInt(Cells[1,Row]); Cells[1,Row]:=IntToHex(PortRSel,4);
  273.    NomRSel:=Row;
  274.    if (PortRSel=0) then begin MessageBeep(0); Exit; end;
  275.    b:=Port[PortRSel];
  276.    Cells[2,Row]:=IntToHex(b,2);
  277.  end;
  278. end;
  279.  
  280. procedure TMainForm.B_ReadAllClick(Sender: TObject);
  281. var i,b       : Byte;
  282.     P,N       : Word;
  283.     cl        : array[1..16] of Byte;
  284.     ports     : array[1..16] of Word;
  285. begin
  286.  with GRead,HwCtrl do
  287.  begin
  288.    N:=0;
  289.    for i:=1 to MaxPorts do
  290.    begin
  291.      P:=HexToInt(Cells[1,i]); Cells[1,i]:=IntToHex(P,4);
  292.      if p>0 then
  293.      begin
  294.        Inc(N); ports[N]:=P; cl[N]:=i;
  295.      end;
  296.    end;
  297.    for i:=1 to N do
  298.    begin
  299.      b:=Port[ports[i]];
  300.      Cells[2,cl[i]]:=IntToHex(b,2);
  301.    end;
  302.  end;
  303. end;
  304.  
  305. procedure TMainForm.B_SetMemoryClick(Sender: TObject);
  306. begin
  307.   PhysAddr:=HexToInt(E_Addr.text); E_Addr.Text:=IntToHex(PhysAddr,8);
  308.   with HwCtrl do  PointPhys:=MapPhysToLinear(PhysAddr,256);
  309.   B_SetMemory.Enabled:=FALSE;
  310.   ShowButtons;
  311. end;
  312.  
  313. procedure TMainForm.B_ReadMemoryClick(Sender: TObject);
  314. var CurrAddr,i,j : dWord;
  315.     s            : String;
  316.     b            : Byte;
  317.     ch           : Char;
  318. begin
  319.   if PointPhys<>NIL then
  320.   begin
  321.     CurrAddr:=PhysAddr;
  322.     for i:=1 to 16 do
  323.     begin
  324.       s:=IntToHex(CurrAddr,8); MemoHex.Cells[0,i]:=s; s:='';
  325.       for j:=1 to 16 do s:=s+IntToHex(PointPhys^[i][j],2);
  326.       MemoHex.Cells[1,i]:=s; s:='';
  327.       for j:=1 to 16 do
  328.       begin
  329.         b:=PointPhys^[i][j];
  330.         if b>=$20 then ch:=Char(b) else ch:='.';  s:=s+ch;
  331.       end;
  332.       MemoHex.Cells[2,i]:=s;
  333.       CurrAddr:=CurrAddr+16;
  334.     end;
  335.  
  336.   end;
  337.  
  338. end;
  339.  
  340. procedure TMainForm.E_AddrChange(Sender: TObject);
  341. begin
  342.   B_SetMemory.Enabled:=HwCtrl.ActiveHW;;
  343. end;
  344.  
  345. procedure TMainForm.HWCtrlHwInterrupt(Sender: TObject);
  346. begin
  347.   Inc(Flag_Intr);
  348. end;
  349.  
  350. procedure TMainForm.Timer1Timer(Sender: TObject);
  351. begin
  352.   with HWCtrl do
  353.   begin
  354.     L_Gen.Caption:=IntToStr(IRQCounter);
  355.     L_Timers.Caption:=IntToStr(Flag_tim div 1000);
  356.     L_Flag.Caption:=IntToStr(Flag_Intr);
  357.     if ActiveHW and IsIRQSet and not Masked then
  358.     begin
  359.       CurrTicker:=GetTickCount;
  360.       Flag_Tim:=Sum_Ticks+CurrTicker-OldTicker;
  361.     end else  OldTicker:=GetTickCount;
  362.   end;
  363. end;
  364.  
  365. procedure TMainForm.B_SetIRQClick(Sender: TObject);
  366. begin
  367.   with HWCtrl do
  368.   begin
  369.     Flag_Intr:=0;
  370.     IRQNumber:=SpinIRQ.Value; Flag_tim:=0;
  371.     if not IsIRQSet then SetIRQ  else DestroyIRQ; Sum_Ticks:=0;
  372.     ShowButtons;
  373.   end;
  374. end;
  375.  
  376. procedure TMainForm.B_MaskClick(Sender: TObject);
  377. begin
  378.   with HWCtrl do
  379.   begin
  380.     if not Masked then
  381.     begin
  382.       MaskInterrupt;
  383.       Sum_Ticks:=Flag_Tim;
  384.     end
  385.     else UnmaskInterrupt;
  386.     ShowButtons;
  387.   end;
  388. end;
  389.  
  390. procedure TMainForm.SpinIRQChange(Sender: TObject);
  391. begin
  392.   HWCtrl.IRQNumber:=SpinIRQ.Value;
  393. end;
  394.  
  395. procedure TMainForm.B_FillMemoryClick(Sender: TObject);
  396. var i,j : byte;
  397. begin
  398.   if PointPhys<>NIL then
  399.   begin
  400.     for i:=1 to 16 do
  401.     begin
  402.       for j:=1 to 16 do PointPhys^[i][j]:=16*(i-1)+j-1;
  403.     end;
  404.   end;
  405. end;
  406.  
  407. procedure TMainForm.B_PulseClick(Sender: TObject);
  408. begin
  409.   HwCtrl.SimulateHwInt;
  410. end;
  411.  
  412. procedure TMainForm.C_HardClick(Sender: TObject);
  413. begin
  414.   HwCtrl.HardAccess:=C_Hard.Checked;
  415. end;
  416.  
  417. initialization
  418.   NomWSel:=0; NomRSel:=0; PointPhys:=NIL; Flag_Intr:=0; Flag_tim:=0;
  419.   Sum_Ticks:=0;CurrTicker:=0; OldTicker:=0;
  420. end.
  421.